COMMENT ⊗   VALID 00010 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE	VIXFAI
C00009 00003	X1←←A ↔ Y1←←B ↔ X2←←C ↔ Y2←←D ↔ BT←ARRY2
C00014 00004	GRYUP:	0
C00015 00005	TONUP:	0
C00016 00006	TABLES FOR FRACTIONATING ERRORS FOR THE HALFTONE ALGORITHM
C00019 00007		TITLE	VIXFA1
C00022 00008	TONUP:	0
C00025 00009	******************** SAIL INTERFACE ***********************
C00029 00010	ARRY←5 ↔ X1←1 ↔ Y1←2 ↔ X2←3 ↔ Y2←4 ↔ BT←0 ↔ XA←6 ↔ YA←7
C00035 ENDMK
C⊗;
	TITLE	VIXFAI
	EXTERN	XL,YH,XSC,YSC
	EXTERN	SLINE,DBUF,BSK
	EXTERN	CORGET,CORREL
	ENTRY	VID

DWINXL:	0
DWINYL:	0
DWINXH:	20*40-2
DWINYH:	740-1

	PCLN←←0
	PCWD←←1
	PCBY←←2
	PCBYA←←3
	LNWD←←4
	LNBY←←5
	LNBYA←←6
	WDBY←←7
	WDBI←←10
	BYBI←←11
	BPTAB←←12
	LINTAB←←13

	T←1  ↔  TT←2  ↔  TTT←3  ↔  ARRY1←4  ↔  ARRY2←5  ↔  P←17
	A←6  ↔  B←7  ↔  C←10  ↔  D←11  ↔  E←13  ↔  F←14  ↔  G←15

RETAD:	0
TEMP:	BLOCK	25		;TEMPORARY STORAGE FOR STUFF

	DEFINE	FLOAT(N)
<	TLC	N,232000
	FADR	N,N	>

	OPDEF	FIX[247000233000]
X1←←A ↔ Y1←←B ↔ X2←←C ↔ Y2←←D ↔ BT←ARRY2
THIS←←TT ↔ SIZ←←TTT

XCNTR←←TEMP ↔ YCNTR←←TEMP+1 ↔ DELX←←TEMP+2 ↔ DELY←←TEMP+3
PICX←←TEMP+4 ↔ PICY←←TEMP+5 ↔ DDLIN←←TEMP+6 ↔ LINB←←TEMP+7

VID:	POP	P,RETAD		;PUT UP BITS BT (A MASK, USUALLY ONLY ONE BIT
	POP	P,BT		;IS ON, IF MULTIPLE BITS ARE ON, THEY ARE OR'D)
	POP	P,ARRY1		;OF PICTURE PIC INTO DD RECTANGLE X1-X2,Y1-Y2
	POP	P,Y2		; VIDEO(X1,Y1,X2,Y2,PIC,BT)
	FSBR	Y2,YH		;IF BT IS -1,
	FMPR	Y2,YSC		;PUT UP A RANDOM DOT REPRESENTATION INSTEAD
	FIX	Y2,
	POP	P,X2
	FSBR	X2,XL
	FMPR	X2,XSC
	FIX	X2,
	POP	P,Y1
	FSBR	Y1,YH
	FMPR	Y1,YSC
	FIX	Y1,
	POP	P,X1
	FSBR	X1,XL
	FMPR	X1,XSC
	FIX	X1,

	CAML	X1,X2			;PUT UP THE BITS MASKED BY BT
	EXCH	X1,X2			;OF PICTURE ARRY IN DD BUFFER
	CAML	Y1,Y2			;RECTANGLE X1-X2, Y1-Y2
	EXCH	Y1,Y2
	HRREI	T,1(X2)			;CALCULATE WIDTH AND HEIGHT,
	SUB	T,X1			;IN DATA DISC PIXELS,
	MOVEM	T,XCNTR			;OF THE FULL PICTURE
	HRREI	T,1(Y2)
	SUB	T,Y1			;THEN CALCULATE THE
	MOVEM	T,YCNTR			;STEP SIZE THROUGH THE ORIGINAL
	HRLZ	T,LNBY(ARRY1)		;PICTURE EACH DD PIXEL REPRESENTS,
	IDIV	T,XCNTR			;AS A FIXED POINT WRD WITH THE
	MOVEM	T,DELX			;RADIX POINT IN THE MIDDLE
	HRLZ	T,PCLN(ARRY1)
	IDIV	T,YCNTR
	MOVEM	T,DELY

	SETZ	PICY
	CAML	Y1,DWINYL		;CHECK IF LOWER AND UPPER
	JRST	YLOK
	MOVN	T,Y1			;BOUNDS OF THE IMAGE EXCEED THE
	IMUL	T,DELY			;EXTERNAL WINDOWING CONSTRAINTS
	MOVEM	T,PICY
	MOVE	Y1,DWINYL
YLOK:	CAMLE	Y2,DWINYH
	MOVE	Y2,DWINYH

	SETZ	PICX
	CAML	X1,DWINXL
	JRST	XLOK
	MOVN	T,X1
	IMUL	T,DELX
	MOVEM	T,PICX
	MOVE	X1,DWINXL
XLOK:	CAMLE	X2,DWINXH
	MOVE	X2,DWINXH

	CAMG	X1,X2			;IF THIS PROCESS LEAVES NOTHING,
	CAMLE	Y1,Y2			;WE CAN QUIT
	JRST	@RETAD

	SUBM	X1,X2			;GENERATE LOOP COUNTERS
	SUBM	Y1,Y2
	HRLI	X1,-1(X2)
	HRLI	Y1,-1(Y2)

	HLRE	SIZ,Y1
	MOVN	SIZ,SIZ			;RESERVE SPACE FOR BYTE PNTR TABLE
	PUSHJ	P,CORGET
	HALT
	MOVEM	THIS,DDLIN

	MOVE	E,DELY
	MOVE	T,Y1			;GENERATE TABLE OF LINE ADDRESSES
	HRR	T,DDLIN
	HRLZI	TT,LINTAB(ARRY1)
	ADD	TT,PICY

YLLP:	HLRZ	TTT,TT			;INTO THE ACTUAL PICTURE COLUMNS WHICH
RTF:	MOVE	TTT,(TTT)		;CORRESPOND TO DD COLUMNS
	MOVEM	TTT,(T)
	ADD	TT,E
	AOBJN	T,YLLP


	CAMN	BT,[-1]
	JRST	[	JSR	TONUP
			JRST	DONE  ]
	CAMN	BT,[-2]
	JRST	[	JSR	HAFUP
			JRST	DONE  ]
	JSR	GRYUP

DONE:	MOVE	THIS,DDLIN
	PUSHJ	P,CORREL
	JRST	@RETAD
GRYUP:	0
	HRRM	BT,TI
	MOVN	T,Y1
	ADD	T,DDLIN
	HRRM	T,YLP

	HRLZ	E,BPTAB(ARRY1)
	ADD	E,PICX

XLP:	HRRZ	T,X1
	LSH	T,-5
	ADD	T,[ORM F,DBUF(TT)]
	HRRM	T,TJ
	HRRZ	F,X1
	ANDI	F,37
	MOVE	F,BSK(F)
	MOVE	T,Y1
	HLRZ	TTT,E
	MOVE	TTT,(TTT)
	TLO	TTT,TT			;SET UP INDEX FIELD IN BYTE PNTR

YLP:	MOVE	TT,(T)			;ALTERED TO REFERENCE THE DDLIN TABLE
	LDB	0,TTT
	MOVE	TT,SLINE(T)
TI:	TRNE	0,BT			;REPLACED BY ACTUAL MASK
TJ:	ORM	F,DBUF(TT)		;ADD WORD NUMBER WITHIN SCANLINE
	AOBJN	T,YLP

	ADD	E,DELX
	AOBJN	X1,XLP
	JRST	@GRYUP
TONUP:	0
	MOVN	BT,BYBI(ARRY1)
	SUBI	BT,1
	HRRM	BT,TI1
	MOVEI	BT,77753

	MOVN	T,Y1
	ADD	T,DDLIN
	HRRM	T,YLP1

	HRLZ	E,BPTAB(ARRY1)
	ADD	E,PICX

XLP1:	HRRZ	T,X1
	LSH	T,-5
	ADD	T,[ORM F,DBUF(TT)]
	HRRM	T,TJ1
	HRRZ	F,X1
	ANDI	F,37
	MOVE	F,BSK(F)
	MOVE	T,Y1
	HLRZ	TTT,E
	MOVE	TTT,(TTT)
	TLO	TTT,TT			;SET UP INDEX FIELD IN BYTE PNTR

YLP1:	MOVE	TT,(T)			;ALTERED TO REFERENCE THE DDLIN TABLE
	LDB	0,TTT
	MOVE	TT,SLINE(T)
TI1:	ROT	0,-5			;REPLACED BY ACTUAL MASK
	IMULI	BT,400003
	CAMLE	0,BT
TJ1:	ORM	F,DBUF(TT)		;ADD WORD NUMBER WITHIN SCANLINE
	AOBJN	T,YLP1

	ADD	E,DELX
	AOBJN	X1,XLP1
	JRST	@TONUP
;TABLES FOR FRACTIONATING ERRORS FOR THE HALFTONE ALGORITHM

	FOR I←-20,-1,1  {   (3*I+10)/20
					}
T1:	FOR I←0,40,1    {   (3*I+10)/20
					}

	FOR I←-20,-1,1  {   (5*I+10)/20
					}
T2:	FOR I←0,40,1    {   (5*I+10)/20
					}

	FOR I←-20,-1,1  {    (I+10)/20
					}
T3:	FOR I←0,40,1    {    (I+10)/20
					}

	FOR I←-20,-1,1  {I-(((3*I+10)/20)+((5*I+10)/20)+((I+10)/20))
								}
T4:	FOR I←0,40,1    {I-(((3*I+10)/20)+((5*I+10)/20)+((I+10)/20))
								}



HAFUP:	0				;HIGH QUALITY HALFTONES
	HLRE	SIZ,Y1
	MOVN	SIZ,SIZ
	ADDI	SIZ,2
	PUSHJ	P,CORGET
	HALT
	SETZ	(THIS)			;RESERVE AND CLEAR A
	HRL	0,THIS			;LINE BUFFER
	HRRI	0,1(THIS)
	MOVEI	T,-1(THIS)
	ADD	T,SIZ
	BLT	0,(T)

	MOVEM	THIS,LINB		;CREATE REFERENCES TO THE
	SUBI	THIS,(Y1)		;LINE BUFFER
	HRRM	THIS,LBM1
	ADDI	THIS,1
	HRRM	THIS,LB
	ADDI	THIS,1
	HRRM	THIS,LBP1

	MOVN	T,Y1
	ADD	T,DDLIN
	HRRM	T,YLP2

	MOVN	T,BYBI(ARRY1)		;SET UP SHIFT COUNT
	ADDI	T,4			;FOR REDUCTION OF PIXELS
	HRRM	T,SHIF			;TO FOUR BITS

	HRLZ	E,BPTAB(ARRY1)
	ADD	E,PICX

XLP2:	HRRZ	T,X1
	LSH	T,-5
	ADD	T,[ORM F,DBUF(TT)]
	HRRM	T,TJ2
	HRRZ	F,X1
	ANDI	F,37
	MOVE	F,BSK(F)
	MOVE	T,Y1
	HLRZ	TTT,E
	MOVE	TTT,(TTT)
	TLO	TTT,TT			;SET UP INDEX FIELD IN BYTE PNTR

	SETZB	C,D
YLP2:	MOVE	TT,(T)			;ALTERED TO REFERENCE THE DDLIN TABLE
	LDB	0,TTT
SHIF:	LSH	0,0			;STRIP IT TO FOUR BITS
	ADD	C,0
	ADD	C,D
	CAIGE	C,10
	JRST	NOTDOT
	MOVE	TT,SLINE(T)
TJ2:	ORM	F,DBUF(TT)		;ADD WORD NUMBER WITHIN SCANLINE
	SUBI	C,17
NOTDOT:	CAMGE	C,[-20]
FOOL:	MOVE	C,[-20]
	CAILE	C,40
FOOG:	MOVEI	C,40
	MOVE	D,T4(C)
	MOVE	0,T1(C)
LBM1:	ADDM	0,-1(T)			;CHANGED TO LINE BUFFER-1
	MOVE	0,T2(C)
LB:	ADDM	0,(T)			;CHANGED TO LINE BUFFER
	MOVE	C,T3(C)
LBP1:	EXCH	C,1(T)			;CHANGED TO LINE BUFFER+1
	AOBJN	T,YLP2

	ADD	E,DELX
	AOBJN	X1,XLP2

	MOVE	THIS,LINB
	PUSHJ	P,CORREL

	JRST	@HAFUP

	PRGEND
	TITLE	VIXFA1
	EXTERN	XL,YH,XSC,YSC
	EXTERN	SLINE,DBUF,BSK
	EXTERN	CORGET,CORREL
	ENTRY	VIDEO

ARRY←5 ↔ X1←1 ↔ Y1←2 ↔ X2←3 ↔ Y2←4 ↔ BT←0 ↔ XA←6 ↔ YA←7
DX←10 ↔ DY←11 ↔ PICX←12 ↔ PICY←13 ↔ XBIT←14 ↔ XPIC←15 ↔ YPIC←16 ↔ T←17

SCRTCH:	BLOCK	1000

GRYUP:	0
	MOVE	T,ROWTAB
	HRRM	T,RTF
	MOVE	T,COLTAB
	HRRM	T,CTF
	HRRM	BT,TI
	CAML	X1,X2			;PUT UP THE BITS MASKED BY BT
	EXCH	X1,X2			;OF PICTURE ARRY IN DD BUFFER
	CAML	Y1,Y2			;RECTANGLE X1-X2, Y1-Y2
	EXCH	Y1,Y2
	HRREI	XA,1(X2)
	SUB	XA,X1
	HRREI	YA,1(Y2)
	SUB	YA,Y1
	HRLZ	DX,PICWID
	IDIV	DX,XA
	HRLZ	DY,PICHIG
	IDIV	DY,YA
	SETZB	PICY,PICX
	JUMPGE	Y1,YLOK			;CHECK IF LOWER AND UPPER
	MOVN	PICY,Y1			;BOUNDS NEED FIXING UP
	IMUL	PICY,DY
	SETZ	Y1,
YLOK:	CAILE	Y2,737
	MOVEI	Y2,737
	JUMPGE	X1,XLOK
	MOVN	PICX,X1
	IMUL	PICX,DX
	SETZ	X1,
XLOK:	CAIL	X2,20*40-1
	MOVEI	X2,20*40-2
	CAMG	X1,X2
	CAMLE	Y1,Y2
	JRST	@GRYUP
	SUBM	X1,X2
	SUBM	Y1,Y2
	HRLI	X1,-1(X2)
	HRLI	Y1,-1(Y2)
	MOVE	YA,Y1
YLLP:	HLRZ	YPIC,PICY
RTF:	MOVE	YPIC,ROWTAB(YPIC)
	MOVEM	YPIC,SCRTCH(YA)
	ADD	PICY,DY
	AOBJN	YA,YLLP

XLP:	HRRZ	XA,X1
	HRRZ	XBIT,X1
	LSH	XA,-5
	ADD	XA,[ORM XBIT,DBUF(YPIC)]
	HRRM	XA,TJ
	ANDI	XBIT,37
	MOVE	XBIT,BSK(XBIT)
	MOVE	YA,Y1
	HLRZ	XPIC,PICX
CTF:	MOVE	XPIC,COLTAB(XPIC)
	TLO	XPIC,YPIC		;SET UP INDEX FIELD IN BYTE PNTR

YLP:	MOVE	YPIC,SCRTCH(YA)
	LDB	T,XPIC
	MOVE	YPIC,SLINE(YA)
TI:	TRNE	T,BT			;REPLACED BY ACTUAL MASK
TJ:	ORM	XBIT,DBUF(YPIC)		;ADD WORD NUMBER WITHIN SCANLINE
	AOBJN	YA,YLP

	ADD	PICX,DX
	AOBJN	X1,XLP
	JRST	@GRYUP
TONUP:	0
	MOVE	T,ROWTAB
	HRRM	T,RTF1
	MOVE	T,COLTAB
	HRRM	T,CTF1
	MOVN	BT,PICBIT
	SUBI	BT,1
	HRRM	BT,TIH
	MOVEI	BT,737373
	CAML	X1,X2			;PUT UP THE
	EXCH	X1,X2			;PICTURE ARRY IN DD BUFFER
	CAML	Y1,Y2			;RECTANGLE X1-X2, Y1-Y2
	EXCH	Y1,Y2			;AS A RANDOM DOT PATTERN
	HRREI	XA,1(X2)
	SUB	XA,X1
	HRREI	YA,1(Y2)
	SUB	YA,Y1
	HRLZ	DX,PICWID
	IDIV	DX,XA
	HRLZ	DY,PICHIG
	IDIV	DY,YA
	SETZB	PICY,PICX
	JUMPGE	Y1,YLOKH		;CHECK IF LOWER AND UPPER
	MOVN	PICY,Y1			;BOUNDS NEED FIXING UP
	IMUL	PICY,DY
	SETZ	Y1,
YLOKH:	CAILE	Y2,740
	MOVEI	Y2,740
	JUMPGE	X1,XLOKH
	MOVN	PICX,X1
	IMUL	PICX,DX
	SETZ	X1,
XLOKH:	CAIL	X2,20*40-1
	MOVEI	X2,20*40-2
	CAMG	X1,X2
	CAMLE	Y1,Y2
	JRST	@TONUP
	SUBM	X1,X2
	SUBM	Y1,Y2
	HRLI	X1,-1(X2)
	HRLI	Y1,-1(Y2)
	MOVE	YA,Y1
YLLPH:	HLRZ	YPIC,PICY
RTF1:	MOVE	YPIC,ROWTAB(YPIC)
	MOVEM	YPIC,SCRTCH(YA)
	ADD	PICY,DY
	AOBJN	YA,YLLPH

XLPH:	HRRZ	XA,X1
	HRRZ	XBIT,X1
	LSH	XA,-5
	ADD	XA,[ORM XBIT,DBUF(YPIC)]
	HRRM	XA,TJH
	ANDI	XBIT,37
	MOVE	XBIT,BSK(XBIT)
	MOVE	YA,Y1
	HLRZ	XPIC,PICX
CTF1:	MOVE	XPIC,COLTAB(XPIC)
	TLO	XPIC,YPIC		;SET UP INDEX FIELD IN BYTE PNTR

YLPH:	MOVE	YPIC,SCRTCH(YA)
	LDB	T,XPIC
TIH:	ROT	T,-5			;REPLACED BY -PICBIT-1
	MOVE	YPIC,SLINE(YA)
        IMULI	BT,400003
	CAMLE	T,BT			;REPLACED BY ACTUAL MASK
TJH:	ORM	XBIT,DBUF(YPIC)		;ADD WORD NUMBER WITHIN SCANLINE
	AOBJN	YA,YLPH

	ADD	PICX,DX
	AOBJN	X1,XLPH
	JRST	@TONUP
;******************** SAIL INTERFACE ***********************
PCLN←←0
PCWD←←1
PCBY←←2
PCBYA←←3
LNWD←←4
LNBY←←5
LNBYA←←6
WDBY←←7
WDBI←←10
BYBI←←11
BPTAB←←12
LINTAB←←13

PICWID:	0
PICLIN:	0
PICHIG:	0
PICBIT:	0
PICWIZ:	0
PICSIZ:	0
COLTAB:	0
ROWTAB:	0

SETUP:	0
	MOVE	T,PCWD(ARRY)		;SET "GLOBALS" FOR COMPATABILITY WITH
	MOVEM	T,PICSIZ		;OLD FORMAT
	MOVE	T,LNBYA(ARRY)
	MOVEM	T,PICWIZ
	MOVE	T,BYBI(ARRY)
	MOVEM	T,PICBIT
	MOVE	T,PCLN(ARRY)
	MOVEM	T,PICHIG
	MOVE	T,LNWD(ARRY)
	MOVEM	T,PICLIN
	MOVE	T,LNBY(ARRY)
	MOVEM	T,PICWID
	MOVE	T,BPTAB(ARRY)
	MOVEM	T,COLTAB
	MOVEI	T,LINTAB(ARRY)
	MOVEM	T,ROWTAB
	MOVE	ARRY,(T)
	JRST	@SETUP


	P←17

	DEFINE	FLOAT(N)
<	TLC	N,232000
	FADR	N,N	>

	OPDEF	FIX[247000233000]

	DEFINE	SAVAC(N)
<	IFGE	N-12,{MOVEM 12,ACS12}
	IFGE	N-16,{MOVEM 16,ACS16}
	IFGE	N-17,{MOVEM 17,ACS17}	>


	DEFINE	RESAC(N)
<	IFGE	N-12,{MOVE 12,ACS12}
	IFGE	N-16,{MOVE 16,ACS16}
	IFGE	N-17,{MOVE 17,ACS17}	>

RETAD:	0
ACS12:	0
ACS16:	0
ACS17:	0
GOODFL:	0
BUGGFL:	0

VIDEO:	POP	P,RETAD		;PUT UP BITS BT (A MASK, USUALLY ONLY ONE BIT
	POP	P,BT		;IS ON, IF MULTIPLE BITS ARE ON, THEY ARE OR'D)
	POP	P,ARRY		;OF PICTURE PIC INTO DD RECTANGLE X1-X2,Y1-Y2
	POP	P,Y2		; VIDEO(X1,Y1,X2,Y2,PIC,BT)
	FSBR	Y2,YH		;IF BT IS -1,
	FMPR	Y2,YSC		;PUT UP A RANDOM DOT REPRESENTATION INSTEAD
	FIX	Y2,		;IF BT IS -2, A HIGH QUALITY HALFTONE
	POP	P,X2		;IF -3, A SLIGHTLY WORSE ONE
	FSBR	X2,XL
	FMPR	X2,XSC
	FIX	X2,
	POP	P,Y1
	FSBR	Y1,YH
	FMPR	Y1,YSC
	FIX	Y1,
	POP	P,X1
	FSBR	X1,XL
	FMPR	X1,XSC
	FIX	X1,
	SAVAC(17)
	JSR	SETUP
	SETZM	BUGGFL
	CAMN	BT,[-1]
	JRST	[	JSR	TONUP
			JRST	DONE  ]
	CAMN	BT,[-2]
	JRST	[	SETZM	GOODFL
			JSR	HAFUP
			JRST	DONE  ]
	CAMN	BT,[-3]
	JRST	[	SETOM	GOODFL
			JSR	HAFUP
			JRST	DONE  ]
	CAMN	BT,[-4]
	JRST	[	SETOM	BUGGFL
			SETZM	GOODFL
			JSR	HAFUP
			JRST	DONE  ]
	JSR	GRYUP
DONE:	RESAC(17)
	JRST	@RETAD
ARRY←5 ↔ X1←1 ↔ Y1←2 ↔ X2←3 ↔ Y2←4 ↔ BT←0 ↔ XA←6 ↔ YA←7
DX←10 ↔ DY←11 ↔ PICX←12 ↔ PICY←13 ↔ XBIT←14 ↔ XPIC←15 ↔ YPIC←16 ↔ T←17
THISS:	0
SIZS:	0
HAFUP:	0				;HIGH QUALITY HALFTONES
	MOVE	T,ROWTAB
	HRRM	T,RTF2
	MOVE	T,COLTAB
	HRRM	T,CTF2
	HRRM	T,CTF2A
	CAML	X1,X2			;PUT UP THE BITS MASKED BY BT
	EXCH	X1,X2			;OF PICTURE ARRY IN DD BUFFER
	CAML	Y1,Y2			;RECTANGLE X1-X2, Y1-Y2
	EXCH	Y1,Y2
	HRREI	XA,1(X2)
	SUB	XA,X1
	HRREI	YA,1(Y2)
	SUB	YA,Y1
	HRLZ	DX,PICWID
	IDIV	DX,XA
	HRLZ	DY,PICHIG
	IDIV	DY,YA
	SETZB	PICY,PICX
	JUMPGE	Y1,YLOK2		;CHECK IF LOWER AND UPPER
	MOVN	PICY,Y1			;BOUNDS NEED FIXING UP
	IMUL	PICY,DY
	SETZ	Y1,
YLOK2:	CAILE	Y2,740-1
	MOVEI	Y2,740-1
	JUMPGE	X1,XLOK2
	MOVN	PICX,X1
	IMUL	PICX,DX
	SETZ	X1,
XLOK2:	CAIL	X2,20*40-1
	MOVEI	X2,20*40-2
	CAMG	X1,X2
	CAMLE	Y1,Y2
	JRST	@HAFUP

LINA←←0 ↔ LINB←←0 ↔ HALFV←←0		;DUMMY NAMES FOR LINE BUFFER AND 1/2 PIXEL

THIS←Y1 ↔ SIZ←X2
	MOVEM	THIS,THISS		;SAVE THESE
	MOVEM	SIZ,SIZS		;ALLOCATE CORE FOR TWO LINE BUFFERS
	EXCH	P,ACS17
	MOVEI	SIZ,2000
	PUSHJ	P,CORGET
	HALT
	ADDI	THIS,2
	HRRM	THIS,LAAM		;SET UP LINE BUFFER REFERENCES
	ADDI	THIS,1
	HRRM	THIS,LBA
	HRRM	THIS,LAA
	ADDI	THIS,1
	HRRM	THIS,LAAP
	HRRM	THIS,LBAP
	ADDI	THIS,1000
	HRRM	THIS,LABM
	ADDI	THIS,1
	HRRM	THIS,LBB
	HRRM	THIS,LAB
	ADDI	THIS,1
	HRRM	THIS,LABP
	HRRM	THIS,LBBP
	SUBI	THIS,1006
	SETZM	(THIS)
	HRL	BT,THIS
	HRRI	BT,1(THIS)
	BLT	BT,1777(THIS)
	EXCH	THIS,THISS
	MOVE	SIZ,SIZS
	EXCH	P,ACS17

	MOVEI	BT,1				;BYTE WIDTH CALCULATION
	LSH	BT,@PICBIT
	HRRM	BT,LBH
	HRRM	BT,LDH
	LSH	BT,-1
	HLL	BT,[CAIGE BT,0]  ;arty bug option
        SKIPE	BUGGFL
	HLL	BT,[TRNN BT,0]
	MOVEM	BT,LAH
	MOVEM	BT,LCH

	SUBM	X1,X2
	SUBM	Y1,Y2
	HRLI	X1,-1(X2)
	HRLI	Y1,-1(Y2)
	MOVE	YA,Y1
YLLP2:	HLRZ	YPIC,PICY
RTF2:	MOVE	YPIC,ROWTAB(YPIC)
	MOVEM	YPIC,SCRTCH(YA)
	ADD	PICY,DY
	AOBJN	YA,YLLP2

XLP2:	HRRZ	XA,X1
	HRRZ	XBIT,X1
	LSH	XA,-5
	ADD	XA,[ORM XBIT,DBUF(YPIC)]
	HRRM	XA,TJ2
	ANDI	XBIT,37
	MOVE	XBIT,BSK(XBIT)
	MOVE	YA,Y1
	HLRZ	XPIC,PICX
CTF2:	MOVE	XPIC,COLTAB(XPIC)
	TLO	XPIC,YPIC		;SET UP INDEX FIELD IN BYTE PNTR

YLP2:	MOVE	YPIC,SCRTCH(YA)
	LDB	T,XPIC
	SETZ	BT,
LAA:	EXCH	BT,LINA(YA)		;CHANGED TO LINA
	ADD	BT,T
LAH:	CAIGE	BT,HALFV		;CHANGED TO ACTUAL 1/2 MAX PIXEL VALUE
	JRST	GTH
	MOVE	YPIC,SLINE(YA)
TJ2:	ORM	XBIT,DBUF(YPIC)		;ADD WORD NUMBER WITHIN SCANLINE
LBH:	SUBI	BT,HALFV
GTH:	MOVE	T,BT
	ASH	BT,-2
LABM:	ADDM	BT,LINB-1(YA)		;CHNGED TO ACTUAL ADDR-1 OF LINB BUFFER
LAB:	ADDM	BT,LINB(YA)
	SUB	T,BT
	SUB	T,BT
  SKIPE GOODFL
  JRST  LAAP
	ASH	BT,-1
LABP:	ADDM	BT,LINB+1(YA)
	SUB	T,BT
LAAP:	ADDM	T,LINA+1(YA)
	AOBJN	YA,YLP2
					;POSSIBLE PATTERNS ARE
					;     *  7        *  3        *  2
					;  3  5  1     2  2  1     1  1  0
	ADD	PICX,DX
	AOBJP	X1,ENDXL

XLP2A:	HRRZ	XA,X1
	HRRZ	XBIT,X1
	LSH	XA,-5
	ADD	XA,[ORM XBIT,DBUF(YPIC)]
	HRRM	XA,TI2
	ANDI	XBIT,37
	MOVE	XBIT,BSK(XBIT)
	MOVE	YA,Y1
	HLRZ	XPIC,PICX
CTF2A:	MOVE	XPIC,COLTAB(XPIC)
	TLO	XPIC,YPIC		;SET UP INDEX FIELD IN BYTE PNTR

YLP2A:	MOVE	YPIC,SCRTCH(YA)
	LDB	T,XPIC
	SETZ	BT,
LBB:	EXCH	BT,LINB(YA)		;CHANGED TO LINA
	ADD	BT,T
LCH:	CAIGE	BT,HALFV		;CHANGED TO ACTUAL 1/2 MAX PIXEL VALUE
	JRST	GTH1
	MOVE	YPIC,SLINE(YA)
TI2:	ORM	XBIT,DBUF(YPIC)		;ADD WORD NUMBER WITHIN SCANLINE
LDH:	SUBI	BT,HALFV
GTH1:	MOVE	T,BT
	ASH	BT,-2
LAAM:	ADDM	BT,LINA-1(YA)		;CHNGED TO ACTUAL ADDR-1 OF LINB BUFFER
LBA:	ADDM	BT,LINA(YA)
	SUB	T,BT
	SUB	T,BT
  SKIPE GOODFL
  JRST  LBBP
	ASH	BT,-1
LBAP:	ADDM	BT,LINA+1(YA)
	SUB	T,BT
LBBP:	ADDM	T,LINB+1(YA)
	AOBJN	YA,YLP2A

	ADD	PICX,DX
	AOBJN	X1,XLP2

ENDXL:	MOVE	P,ACS17
	MOVE	THIS,THISS
	PUSHJ	P,CORREL

	JRST	@HAFUP

	END